<%
Class JpegClass
	'AspJpeg组件名称
	Private s_objName
	'默认AspJpeg对象,临时AspJpeg对象,第二临时AspJpeg对象
	Private s_AspJpeg, s_AspJpegT, s_AspJpegB, t_Gif
	'图片宽度,高度,质量,透明度,强制生成指定尺寸,图片背景颜色
	Public Width, Height, Quality, Opacity, Force, BackGroundColor
	'画笔颜色,画笔宽度,是否加粗,字体路径,水印图片路径
	Public PenColor, PenWidth, BrushSolid, Font, WaterMarkImgPath
	Private s_Position
	'当前二进制流
	Private s_Binary
	'是否PNG输出
	Private s_pngOutput
	'指定组件注册序列号
	Private s_RegKey
	'内部使用Fso名称
	Private s_fso
	
	'''构造
	Private Sub Class_Initialize()
		s_objName = "Persits.Jpeg" 'AspJpeg组件名称
		Quality = 100 '生成图片质量
		Opacity = 100 '生成图片透明度
		Width = 200 '默认图片宽度
		Height = 200 '默认图片高度
		Force = False '是否强制生成固定大小图片
		BackGroundColor = &HFFFFFF '背景色
		PenColor = &H000000 '画笔颜色
		PenWidth = 1 '画笔宽度
		BrushSolid = False '是否加粗处理
		WaterMarkImgPath = ""
		Font = "" '文字水印使用的字体路径
		s_pngOutput = False '是否PNG输出
		s_Binary = Null '图片的二进制数据
		s_RegKey = ""
		'AB.Error(10001) = "服务器没有安装AspJpeg组件."
		'AB.Error(10002) = "来源路径错误或文件不存在."
		'AB.Error(10003) = "存储路径错误或路径不存在."
		'AB.Error(10004) = "水印图片路径错误或水印图片不存在."
		'AB.Error(10005) = "参数不能为空."
		'AB.Error(10006) = "不是Gif格式的图片."
		Set s_AspJpeg=[New]()
		Set s_fso 	= Server.CreateObject(C_FsoName)
	End Sub

	'''析构
	Private Sub Class_Terminate()
		If IsObject(s_AspJpeg) Then
			s_AspJpeg.Close
			Set s_AspJpeg = Nothing
		End If
		Set s_fso = Nothing
	End Sub

	'''创建一个新的AspJpeg对象
	Public Function [New]()
		If IsInstall(s_objName) Then
			Set [New] =  Server.CreateObject(s_objName)
			If Has(s_RegKey) Then
				[New].RegKey = s_RegKey
			End If
		Else
			Errc.Throw(99)
		End If
	End Function

	'''返回AspJpeg版本
	Public Property Get Version()
		Version = s_AspJpeg.Version
	End Property

	'''返回当前操作的AspJpeg对象用于直接操作
	Public Property Get AspJpeg()
		Set AspJpeg = s_AspJpeg
	End Property

	'''返回AspJpeg组件过期日期
	Public Property Get [Expires]()
		[Expires] = s_AspJpeg.Expires
	End Property

	'''设置AspJpeg组件的注册码
	'p_k:序列号
	Public Property Let RegKey(Byval p_k)
		s_AspJpeg.RegKey = p_k
		s_RegKey = p_k
	End Property

	'''获取实际路径MapPath,不支持通配符
	'p_p:路径
	Private Function absPath_(Byval p_p)
		If CStr(p_p) = "" Then
			absPath_ = "" : Exit Function
		End If
		If Mid(p_p,2,1)<>":" Then
			p_p = Server.MapPath(p_p)
		End If
		If Right(p_p,1) = "\" Then
			p_p = Left(p_p,Len(p_p)-1)
		End If
		absPath_ = p_p
	End Function
	
	'''取文件扩展名(后缀名)
	'p_f:文件名(可带路径一起)
	Private Function extOf_(Byval p_f)
		Dim t_a : t_a = Split(p_f, ".")
		If Ubound(t_a) > 0 Then
			extOf_ = "." & Lcase(t_a(Ubound(t_a)))
		Else
			extOf_ = ""
		End If
	End Function
	
	'''判断文件是否存在
	'p_p:文件路径
	Private Function isFile_(Byval p_p)
		p_p = absPath_(p_p) : isFile_ = False
		If s_fso.FileExists(p_p) Then
			isFile_ = True
		End If
	End Function
	
	'''根据参数自动调用相应方式打开图片,可以是图片路径，二进制数据
	'p_s:图片路径/二进制数据
	Public Function [Open](Byval p_s)
		If Not Has(p_s) Then
			Errc.Raise(10005)
		End If
		Set s_AspJpegT = [New]()
		Select Case TypeName(p_s)
		Case "String"
			p_s = absPath_(p_s)
			s_AspJpegT.Open p_s
		Case "Byte()"
			s_AspJpegT.OpenBinary p_s
		Case "IASPJpeg"
			Set s_AspJpegT = p_s
		Case Else
			Errc.Raise(10005)
		End Select
		Set [Open] = s_AspJpegT
	End Function

	'''判断是否输出PNG格式图片，如果保存文件扩展名为PNG则按照PNG格式输出保存
	Private Sub setPNGOutput_(Byval p_s)
		If extOf_(p_s) = ".png" Then
			s_pngOutput = True
		Else
			s_pngOutput = False
		End If
	End Sub

	'''验证码函数,如带保存路径则返回保存路径,否则返回读取图片路径
	'p_r:验证码,如果为空则随机生成一个
	'p_s:背景图片路径,必须的
	'p_t:保存位置,如果不保存要置空
	'p_n:要保存的Session名称,为空则为默认RandCode
	Public Function RandCode(Byval p_r, Byval p_s, Byval p_t, Byval p_n)
		If p_r = "" Then
			p_r = RandStr("4:0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
		End If
		Session("RandCode") = p_r
		p_s = absPath_(p_s)
		p_t = absPath_(p_t)
		If Not isFile_(p_s) then
			Errc.Throw(10002)
		End If
		Set s_AspJpeg = [Open](p_s)
		Randomize(Timer())
		Dim t_i
		For t_i = 1 To Len(p_r)
			s_AspJpeg.Canvas.Font.Rotation = (Rnd()*25-5)  '倾斜度
			s_AspJpeg.Canvas.Font.Color = (Rnd()*255)*255*255+(Rnd()*255)*255*255+(Rnd()*255)*255*255 '颜色
			s_AspJpeg.Canvas.Font.Family = "Arial Black" '字体 宋体/黑体/楷体/隶书/
			s_AspJpeg.Canvas.Font.Bold = IfHas(BrushSolid,False)     '是否加粗 true/false
			s_AspJpeg.Canvas.Font.Size = 30       '字体大小
			s_AspJpeg.Canvas.Font.ShadowColor = &HFFFFFF
			s_AspJpeg.Canvas.Font.Quality = 100
			If Has(Font) Then
				s_AspJpeg.Canvas.PrintText 20 * (t_i-1)+5, 0, Mid(p_r,t_i,1) , Font
			Else
				s_AspJpeg.Canvas.PrintText 20 * (t_i-1)+5, 0, Mid(p_r,t_i,1)
			End If
		Next
		s_AspJpeg.Quality = IfHas(Quality,100) '设置加水印后图片的质量
		s_Binary = s_AspJpeg.Binary
		setPNGOutput_(p_t)
		If s_pngOutput Then
			s_AspJpeg.PNGOutput = s_pngOutput
		End If
		If Has(p_t) Then
			s_AspJpeg.Save p_t    '保存
		End If
		RandCode =  IfHas(p_t,p_s)
	End Function

	'''输出当前图片
	Public Sub [Flush]()
		Response.Expires = -9999
		Response.AddHeader "pragma", "no-cache"
		Response.AddHeader "cache-ctrol", "no-cache"
		Response.ContentType = "image/jpeg"
		Response.BinaryWrite s_Binary
	End Sub

	'''生成缩略图,成功返回True,失败返回False
	'p_s:原图片路径
	'p_t:生成图片路径
	'p_w:图片高度
	'p_h:图片宽度
	'p_q:图片品质
	'p_f是否强制宽高
	Public Function Thumbnail(Byval p_s, Byval p_t, Byval p_w, Byval p_h, Byval p_q, Byval p_f)
		On Error Resume Next
		Thumbnail = True
		Dim t_s,t_t,t_q,t_w,t_h,t_f, t_ow, t_oh,t_cw, t_ch,t_is
		t_s = absPath_(p_s)
		t_t = absPath_(p_t)
		If Not isFile_(t_s) Then
			Errc.Raise(10002)
			Thumbnail = False
			Exit Function
		End If
		t_q = IfHas(p_q,Quality)
		t_w = IfHas(p_w,Width)
		t_h = IfHas(p_h,Height)
		t_f = IfHas(p_f,Force)
		Set s_AspJpeg = [Open](t_s)
		t_ow = s_AspJpeg.Width
		t_oh = s_AspJpeg.Height
		t_cw = t_ow
		t_ch = t_oh
		If t_ow > t_w Or t_oh > t_h Then
			If t_ow >= t_w Then
				t_cw = t_w
				t_ch = (t_w * t_oh) / t_ow
			End If
			If t_ch >= t_h Then
				t_ch = t_h
				t_cw = (t_h * t_cw) / t_ch
			End If
		End If
		s_AspJpeg.Width = t_cw
		s_AspJpeg.Height = t_ch
		s_AspJpeg.Quality = IfHas(t_q , IfHas(Quality,100))
		s_AspJpeg.Sharpen 1,250
		If t_f Then
			t_is = IIF(t_cw > t_ch, t_cw, t_ch)
			Set s_AspJpegT = [New]()
			s_AspJpegT.New t_is , t_is , BackGroundColor
			s_AspJpegT.Canvas.DrawImage (t_is - t_cw)/2 ,(t_is - t_ch)/2 ,s_AspJpeg
			s_Binary = s_AspJpegT.Binary
			setPNGOutput_(t_t)
			If s_pngOutput Then
				s_AspJpegT.PNGOutput = s_pngOutput
			End If
			s_AspJpegT.Save t_t
			s_AspJpegT.Close
			Set s_AspJpegT = Nothing
		Else
			s_Binary = s_AspJpeg.Binary
			setPNGOutput_(t_t)
			If s_pngOutput Then
				s_AspJpeg.PNGOutput = s_pngOutput
			End If
			s_AspJpeg.Save t_t
		End If
		If Err.Number<>0 Then
			Thumbnail = False
			'收集错误,Log信息收集
			Errc.Raise(2)
		End If
		Err.Clear()
	End Function

	'''默认函数，感觉缩略图用的会比较多，就把生成缩略图作为了默认函数
	'''缩略图函数Thumbnail简化函数
	Public Default Function T(Byval p_s, Byval p_t, Byval p_w, Byval p_h, Byval p_q, Byval p_f)
		T = Thumbnail(p_s, p_t, p_w, p_h, p_q, p_f)
	End Function
	
	'''合并图片(以第二张为基础),成功返回True,失败返回False
	'p_s:原图片路径
	'p_t:第二张图片路径
	'p_r:生成的合并图片路径,如果为空则已第二张图片路径为保存路径
	'p_x:第一张图在第二张图的x轴
	'p_y:第一张图在第二张图的y轴
	Public Function Merge(Byval p_s,Byval p_t,Byval p_r, Byval p_x, Byval p_y)
		On Error Resume Next
		Merge = True
		Dim t_s,t_t,t_o,t_b,t_r
		t_s = absPath_(p_s)
		t_t = absPath_(p_t)
		If Not isFile_(t_s) Then
			Errc.Raise(10002)
		End If
		If Not isFile_(t_t) Then
			Errc.Raise(10003)
		End If
		If Has(p_r) Then
			t_r = absPath_(p_r)
		Else
			t_r = t_t
		End If
		Set t_o = [Open](t_s)
		Set t_b = [Open](t_t)
		t_x = IfHas(p_x,(t_b.Width - t_o.Width) / 2)
		t_y = IfHas(p_y,(t_b.Height - t_o.Height) / 2)
		t_b.Canvas.DrawImage t_x,t_y,t_o
		setPNGOutput_(t_r)
		If s_pngOutput Then
			t_b.PNGOutput = s_pngOutput
		End If
		t_b.Save t_r
		s_Binary = t_b.Binary
		t_o.Close
		t_b.Close
		Set t_o = Nothing
		Set t_b = Nothing
		If Err.Number<>0 Then
			Merge = False
			'收集错误,Log信息收集
			Errc.Raise(2)
		End If
		Err.Clear()
	End Function

	'''根据参数返回水印坐标位置的数组
	'p_k:图片宽
	'p_g:图片高
	'p_w:水印宽
	'p_h:水印高
	'p_p:水印位置
	Public Function WaterMarkPosition(Byval p_k, Byval p_g, Byval p_w, Byval p_h, Byval p_p)
		Dim t_p(2)
		Select Case p_p
		Case 1
			'顶部居左
			t_p(0) = 0
			t_p(1) = 0
		Case 2
			'顶部居中
			t_p(0) = Int((p_k - p_w) / 2)
			t_p(1) = 0
		Case 3
			'顶部居右
			t_p(0) = p_k - p_w
			t_p(1) = 0
		Case 4
			'中心位置
			t_p(0) = Int((p_k - p_w) / 2)
			t_p(1) = Int((p_g - p_h) / 2)
		Case 5
			'底部居左
			t_p(0) = 0
			t_p(1) = p_g - p_h  - 10
		Case 6
			'底部居中
			t_p(0) = Int((p_k - p_w) / 2)
			t_p(1) = p_g - p_h  - 10
		Case 7
			'底部居右
			t_p(0) = p_k - p_w
			t_p(1) = p_g - p_h - 10
		Case Else
			'随机位置
			Randomize(Timer())
			t_p(0) = Int(Rand(0,(p_k - p_w)))
			Randomize(Timer())
			t_p(1) = Int(Int(p_g - p_h + 1) * Rnd())
		End Select
		WaterMarkPosition = t_p
	End Function

	'''添加文字水印(文字,背景图片路径,水印位置,水印质量,水印透明度,水印文字角度,文字颜色,文字字体,是否加粗,文字尺寸)
	'p_s:水印文字
	'p_b:背景图片(即要加水印的图片)路径
	'p_p:水印位置值,参考WaterMarkPosition
	'p_q:生成图片质量
	'p_o:水印透明度
	'p_r:倾斜度
	'p_c:文字颜色
	'p_f:文字字体
	'p_d:是否加粗
	'p_z;文字尺寸
	Public Function WaterMarkFont(Byval p_s, Byval p_b, Byval p_p, Byval p_q, Byval p_o, Byval p_r, Byval p_c, Byval p_f, Byval p_d, Byval p_z)
		On Error Resume Next
		WaterMarkFont = True
		Dim t_s,t_fh,t_fw,t_wmp
		t_s = absPath_(p_b)
		If Not isFile_(t_s) Then
			Errc.Raise(10002)
		End If
		Set s_AspJpegT = [Open](t_s)
		Set s_AspJpegB = [New]()
		s_AspJpegB.New  s_AspJpegT.Width , s_AspJpegT.Height , BackGroundColor
		If Has(p_r) Then
			s_AspJpegB.Canvas.Font.Rotation = p_r  '倾斜度
		End If
		s_AspJpegB.Canvas.Font.Color = IfHas(p_c,PenColor) '颜色
		s_AspJpegB.Canvas.Font.Family = IfHas(p_f,"Arial") '字体 宋体/黑体/楷体/隶书/
		s_AspJpegB.Canvas.Font.Bold = IfHas(p_d,IfHas(BrushSolid,False))     '是否加骈 true/
		s_AspJpegB.Canvas.Font.Size = IfHas(p_z,30)
		s_AspJpegB.Canvas.Font.Opacity = 1
		s_AspJpegB.Canvas.Font.Quality = IfHas(p_q,Quality)
		t_fh = Int(Round( (IfHas(p_z,30) / 2 )))
		t_fw = Int(Round( t_fh * Len(p_s)))
		't_fh = AB.C.ifHas(p_z,30)
		't_fw = t_fh * Len(p_s)
		t_wmp = WaterMarkPosition(s_AspJpegT.Width , s_AspJpegT.Height , t_fw , t_fh , p_p)
		If Has(Font) And Not Has(p_f) Then
			s_AspJpegB.Canvas.PrintText t_wmp(0), t_wmp(1), p_s , Font
		Else
			s_AspJpegB.Canvas.PrintText t_wmp(0), t_wmp(1), p_s
		End If
		s_AspJpegT.Canvas.DrawImage 0, 0, s_AspJpegB , IfHas(p_o ,IfHas(Opacity,100) ) / 100 , BackGroundColor
		s_Binary = s_AspJpegT.Binary
		setPNGOutput_(t_s)
		If s_pngOutput Then
			s_AspJpegT.PNGOutput = s_pngOutput
		End If
		s_AspJpegT.Save t_s
		s_AspJpegB.Close
		Set s_AspJpegB = Nothing
		s_AspJpegT.Close
		Set s_AspJpegT = Nothing
		If Err.Number<>0 Then
			WaterMarkFont = False
			'收集错误,Log信息收集
			Errc.Raise(2)
		End If
		Err.Clear()
	End Function

	'''添加图片水印(水印图片路径,背景图片路径,水印位置,水印质量,水印透明度)
	'p_s:水印图片路径
	'p_t:背景图片路径(即要加水印的图片)
	'p_p:水印位置
	'p_q:水印质量
	'p_o:水印透明度
	Public Function WaterMarkJpeg(Byval p_s, Byval p_t, Byval p_p, Byval p_q, Byval p_o)
		On Error Resume Next
		WaterMarkJpeg = True
		Dim t_f,t_t,t_so,t_to,t_wmp
		t_f = absPath_(p_s)
		t_t = absPath_(p_t)
		If Not isFile_(t_f) Then
			If Not isFile_(WaterMarkImgPath) Then
				Errc.Raise(10004)
			Else
				t_f = WaterMarkImgPath
			End If
		End If
		If Not isFile_(t_t) Then
			Errc.Raise(10003)
		End If
		Set t_so = [Open](t_f)
		Set t_to = [Open](t_t)
		t_wmp = WaterMarkPosition(t_to.Width , t_to.Height , t_so.Width , t_so.Height , p_p)
		t_to.Quality  = IfHas(p_q , Quality)
		If s_pngOutput Then
			t_to.Canvas.DrawPNG t_wmp(0), t_wmp(1) , t_so , IfHas(p_o ,IfHas(Opacity,100)) / 100,BackGroundColor
		Else
			t_to.Canvas.DrawImage t_wmp(0), t_wmp(1) , t_so , IfHas(p_o ,IfHas(Opacity,100)) / 100,BackGroundColor
		End If
		s_Binary = t_to.Binary
		setPNGOutput_(t_t)
		If s_pngOutput Then
			t_to.PNGOutput = s_pngOutput
		End If
		t_to.Save t_t
		t_so.Close
		t_to.Close
		Set t_so = Nothing
		Set t_to = Nothing
		If Err.Number<>0 Then
			WaterMarkJpeg = False
			'收集错误,Log信息收集
			Errc.Raise(2)
		End If
		Err.Clear()
	End Function

	'''简化的添加水印函数，根据参数自动判断是文字水印还是图片水印
	'p_s:水印图片路径或文字
	'p_t:背景图片路径
	'p_p:水印位置
	'p_q:水印质量
	'p_o:水印透明度
	Public Function WaterMark(Byval p_s,Byval p_t,Byval p_p,Byval p_q,Byval p_o)
		If Not isFile_(p_t) Then
			Errc.Raise(10003)
		End If
		If isFile_(p_s) Then
			WaterMark = WaterMarkJpeg( p_s, p_t, p_p, p_q, p_o)
		Else
			WaterMark = WaterMarkFont( p_s, p_t, p_p, p_q, p_o, "", "", "", "", "")
		End If
	End Function

	'''简化的添加水印函数
	'WaterMark的别名
	Public Function Print(Byval p_s,Byval p_t,Byval p_p,Byval p_q,Byval p_o)
		Print = WaterMark( p_s, p_t, p_p, p_q, p_O)
	End Function

	'''图片切割，按照提供的左上角和右下角坐标切割图片
	'p_s:原图片路径
	'p_t:图片存储路径,如果为空则直接覆盖原图片
	'p_tx:左上角X坐标
	'p_ty:左上角y坐标
	'p_bx:右下角x坐标
	'p_by:右下角y坐标
	Public Function Crop(Byval p_s,Byval p_t,Byval p_tx,Byval p_ty,Byval p_bx,Byval p_by)
		On Error Resume Next
		Crop = True
		Dim t_s,t_t,t_o
		t_s = absPath_(p_s)
		t_t = absPath_(IfHas(p_t,p_s))
		If Not isFile_(t_s) Then
			Errc.Raise(10002)
		End If
		Set t_o = [Open](t_s)
		t_o.Crop p_tx,p_ty,p_bx,p_by
		s_Binary = t_o.Binary
		setPNGOutput_(t_t)
		If s_pngOutput Then
			t_o.PNGOutput = s_pngOutput
		End If
		t_o.Save t_t
		t_o.Close
		Set t_o = Nothing
		If Err.Number<>0 Then
			Crop = False
			'收集错误,Log信息收集
			Errc.Raise(2)
		End If
		Err.Clear()
	End Function

	'''Gif动画图片缩放，保留原动画属性
	'p_s:原Gif图片路径
	'p_t:图片存储路径,如果为空则直接覆盖原图片
	'p_w:图片宽度
	'p_h:图片高度,如果为空,则按宽度比率
	'p_a:图片算法,见手册
	Public Function GifResize(Byval p_s,Byval p_t,Byval p_w,Byval p_h,Byval p_a)
		On Error Resume Next
		GifResize = True
		dim t_s,t_t,t_g
		t_s = absPath_(p_s)
		t_t = absPath_(IfHas(p_t,p_s))
		If Not isFile_(t_s) Then
			Errc.Raise(10002)
		End If
		If Lcase(extOf_(t_s)) <> ".gif" Then
			Errc.Raise(10006)
		End If
		Set s_AspJpegT = [New]()
		Set t_g = s_AspJpegT.Gif
		t_g.Open t_s
		If Not Has(p_h) Then
			t_g.Resize p_w
		Else
			t_g.Resize p_w , p_h , IfHas(p_a,0)
		End If
		t_g.Save t_t
		s_Binary = t_g.Binary
		s_AspJpegT.Close
		Set t_g = Nothing
		Set s_AspJpegT = Nothing
		If Err.Number<>0 Then
			GifResize = False
			'收集错误,Log信息收集
			Errc.Raise(2)
		End If
		Err.Clear()
	End Function

	'''Gif动画图片缩放函数简化函数，保留原动画属性
	Public Function G(Byval p_s,Byval p_t,Byval p_w)
		G = GifResize(p_s,p_t,p_w,"","")
	End Function
End Class
%>